home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch14 / Rotate.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-06-25  |  12.9 KB  |  399 lines
  1. VERSION 5.00
  2. Begin VB.Form frmRotate 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Rotate"
  6.    ClientHeight    =   5310
  7.    ClientLeft      =   690
  8.    ClientTop       =   615
  9.    ClientWidth     =   7830
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    KeyPreview      =   -1  'True
  21.    LinkTopic       =   "Form1"
  22.    PaletteMode     =   1  'UseZOrder
  23.    ScaleHeight     =   354
  24.    ScaleMode       =   3  'Pixel
  25.    ScaleWidth      =   522
  26.    Begin VB.Frame Frame2 
  27.       Caption         =   "Curve"
  28.       Height          =   5295
  29.       Left            =   0
  30.       TabIndex        =   1
  31.       Top             =   0
  32.       Width           =   2295
  33.       Begin VB.OptionButton optCurve 
  34.          Caption         =   "Tornado"
  35.          Height          =   255
  36.          Index           =   13
  37.          Left            =   120
  38.          TabIndex        =   15
  39.          Top             =   4920
  40.          Width           =   2055
  41.       End
  42.       Begin VB.OptionButton optCurve 
  43.          Caption         =   "Helix"
  44.          Height          =   255
  45.          Index           =   12
  46.          Left            =   120
  47.          TabIndex        =   14
  48.          Top             =   4560
  49.          Width           =   2055
  50.       End
  51.       Begin VB.OptionButton optCurve 
  52.          Caption         =   "Tower"
  53.          Height          =   255
  54.          Index           =   11
  55.          Left            =   120
  56.          TabIndex        =   13
  57.          Top             =   4200
  58.          Width           =   2055
  59.       End
  60.       Begin VB.OptionButton optCurve 
  61.          Caption         =   "Football"
  62.          Height          =   255
  63.          Index           =   10
  64.          Left            =   120
  65.          TabIndex        =   12
  66.          Top             =   3840
  67.          Width           =   2055
  68.       End
  69.       Begin VB.OptionButton optCurve 
  70.          Caption         =   "Goblet"
  71.          Height          =   255
  72.          Index           =   9
  73.          Left            =   120
  74.          TabIndex        =   11
  75.          Top             =   3480
  76.          Width           =   2055
  77.       End
  78.       Begin VB.OptionButton optCurve 
  79.          Caption         =   "Urn"
  80.          Height          =   255
  81.          Index           =   8
  82.          Left            =   120
  83.          TabIndex        =   10
  84.          Top             =   3120
  85.          Width           =   2055
  86.       End
  87.       Begin VB.OptionButton optCurve 
  88.          Caption         =   "Sine Wave"
  89.          Height          =   255
  90.          Index           =   7
  91.          Left            =   120
  92.          TabIndex        =   9
  93.          Top             =   2760
  94.          Width           =   2055
  95.       End
  96.       Begin VB.OptionButton optCurve 
  97.          Caption         =   "Semicircle 2"
  98.          Height          =   255
  99.          Index           =   6
  100.          Left            =   120
  101.          TabIndex        =   8
  102.          Top             =   2400
  103.          Width           =   2055
  104.       End
  105.       Begin VB.OptionButton optCurve 
  106.          Caption         =   "Semicircle 1"
  107.          Height          =   255
  108.          Index           =   5
  109.          Left            =   120
  110.          TabIndex        =   7
  111.          Top             =   2040
  112.          Width           =   2055
  113.       End
  114.       Begin VB.OptionButton optCurve 
  115.          Caption         =   "Circle 2"
  116.          Height          =   255
  117.          Index           =   4
  118.          Left            =   120
  119.          TabIndex        =   6
  120.          Top             =   1680
  121.          Width           =   2055
  122.       End
  123.       Begin VB.OptionButton optCurve 
  124.          Caption         =   "Circle 1"
  125.          Height          =   255
  126.          Index           =   3
  127.          Left            =   120
  128.          TabIndex        =   5
  129.          Top             =   1320
  130.          Width           =   2055
  131.       End
  132.       Begin VB.OptionButton optCurve 
  133.          Caption         =   "3/4 Rectangle"
  134.          Height          =   255
  135.          Index           =   2
  136.          Left            =   120
  137.          TabIndex        =   4
  138.          Top             =   960
  139.          Width           =   2055
  140.       End
  141.       Begin VB.OptionButton optCurve 
  142.          Caption         =   "Diamond"
  143.          Height          =   255
  144.          Index           =   1
  145.          Left            =   120
  146.          TabIndex        =   3
  147.          Top             =   600
  148.          Width           =   2055
  149.       End
  150.       Begin VB.OptionButton optCurve 
  151.          Caption         =   "Rectangle"
  152.          Height          =   255
  153.          Index           =   0
  154.          Left            =   120
  155.          TabIndex        =   2
  156.          Top             =   240
  157.          Value           =   -1  'True
  158.          Width           =   2055
  159.       End
  160.    End
  161.    Begin VB.PictureBox picCanvas 
  162.       AutoRedraw      =   -1  'True
  163.       Height          =   5295
  164.       Left            =   2400
  165.       ScaleHeight     =   349
  166.       ScaleMode       =   3  'Pixel
  167.       ScaleWidth      =   357
  168.       TabIndex        =   0
  169.       Top             =   0
  170.       Width           =   5415
  171.    End
  172. Attribute VB_Name = "frmRotate"
  173. Attribute VB_GlobalNameSpace = False
  174. Attribute VB_Creatable = False
  175. Attribute VB_PredeclaredId = True
  176. Attribute VB_Exposed = False
  177. Option Explicit
  178. ' Location of viewing eye.
  179. Private EyeR As Single
  180. Private EyeTheta As Single
  181. Private EyePhi As Single
  182. Private Const dtheta = PI / 20
  183. Private Const Dphi = PI / 20
  184. Private Const Dr = 1
  185. ' Location of focus point.
  186. Private Const FocusX = 0#
  187. Private Const FocusY = 0#
  188. Private Const FocusZ = 0#
  189. Private Projector(1 To 4, 1 To 4) As Single
  190. Private SelectedCurve As Integer
  191. Private TheSurface As Rotated3d
  192. ' Create the selected surface.
  193. Private Sub CreateSurface()
  194. Dim R As Single
  195. Dim offset As Single
  196. Dim dtheta As Single
  197. Dim theta As Single
  198. Dim Y As Single
  199.     Set TheSurface = New Rotated3d
  200.     Select Case SelectedCurve
  201.         Case 0  ' Rectangle.
  202.             TheSurface.AddCurvePoint -3, -1.5, 0
  203.             TheSurface.AddCurvePoint -3, 1.5, 0
  204.             TheSurface.AddCurvePoint -1, 1.5, 0
  205.             TheSurface.AddCurvePoint -1, -1.5, 0
  206.             TheSurface.AddCurvePoint -3, -1.5, 0
  207.         Case 1  ' Diamond.
  208.             TheSurface.AddCurvePoint -3, 0, 0
  209.             TheSurface.AddCurvePoint -2, -1, 0
  210.             TheSurface.AddCurvePoint -1, 0, 0
  211.             TheSurface.AddCurvePoint -2, 1, 0
  212.             TheSurface.AddCurvePoint -3, 0, 0
  213.         Case 2  ' 3/4 Rectangle.
  214.             TheSurface.AddCurvePoint 0, -1.5, 0
  215.             TheSurface.AddCurvePoint -3, -1.5, 0
  216.             TheSurface.AddCurvePoint -3, 1.5, 0
  217.             TheSurface.AddCurvePoint 0, 1.5, 0
  218.             TheSurface.AddCurvePoint 0, -1.5, 0
  219.         Case 3, 4   ' Circle 1, circle 2.
  220.             If SelectedCurve = 3 Then
  221.                 R = 2
  222.                 offset = 2
  223.             Else
  224.                 R = 1.5
  225.                 offset = 2.5
  226.             End If
  227.             dtheta = PI / 8
  228.             TheSurface.AddCurvePoint offset + R, 0, 0
  229.             For theta = dtheta To 2 * PI - dtheta + 0.1 Step dtheta
  230.                 TheSurface.AddCurvePoint _
  231.                     offset + R * Cos(theta), R * Sin(theta), 0
  232.             Next theta
  233.             TheSurface.AddCurvePoint offset + R, 0, 0
  234.         Case 5, 6   ' Semicircle 1, semicircle 2.
  235.             If SelectedCurve = 5 Then
  236.                 R = 4
  237.                 offset = 0
  238.             Else
  239.                 R = 2
  240.                 offset = 2
  241.             End If
  242.             dtheta = PI / 8
  243.             TheSurface.AddCurvePoint offset, -R, 0
  244.             For theta = -PI / 2 + dtheta To PI / 2 - dtheta + 0.1 Step dtheta
  245.                 TheSurface.AddCurvePoint _
  246.                     offset + R * Cos(theta), _
  247.                     R * Sin(theta), _
  248.                     0
  249.             Next theta
  250.             TheSurface.AddCurvePoint offset, R, 0
  251.         Case 7  ' Sine wave.
  252.             R = 0.7
  253.             dtheta = PI / 10
  254.             For theta = -PI To PI Step dtheta
  255.                 TheSurface.AddCurvePoint _
  256.                     1 + R + R * Sin(2 * theta), _
  257.                     theta, _
  258.                     0
  259.             Next theta
  260.         Case 8  ' Urn.
  261.             dtheta = PI / 10
  262.             For theta = -PI To PI Step dtheta
  263.                 TheSurface.AddCurvePoint _
  264.                     PI / 2 + (-PI + theta) / 4 * Sin(2 * theta), _
  265.                     theta, _
  266.                     0
  267.             Next theta
  268.         Case 9  ' Goblet.
  269.             TheSurface.AddCurvePoint 3, 3.5, 0
  270.             TheSurface.AddCurvePoint 2.5, 3, 0
  271.             TheSurface.AddCurvePoint 3, 1.5, 0
  272.             TheSurface.AddCurvePoint 2.5, 1, 0
  273.             TheSurface.AddCurvePoint 1, 1, 0
  274.             TheSurface.AddCurvePoint 0.5, 0.5, 0
  275.             TheSurface.AddCurvePoint 0.5, -1, 0
  276.             TheSurface.AddCurvePoint 1, -1.5, 0
  277.             TheSurface.AddCurvePoint 2, -1.5, 0
  278.             TheSurface.AddCurvePoint 2.5, -2, 0
  279.         Case 10 ' Football.
  280.             For Y = -4 To 4 Step 0.5
  281.                 TheSurface.AddCurvePoint 16 / 5 - Y * Y / 5, Y, 0
  282.             Next Y
  283.         Case 11 ' Tower.
  284.             R = 1
  285.             dtheta = PI / 8
  286.             For theta = -PI To -PI / 2 Step dtheta
  287.                 TheSurface.AddCurvePoint _
  288.                     R + R * Cos(theta), _
  289.                     4 * R + R * Sin(theta), _
  290.                     0
  291.             Next theta
  292.             For theta = PI / 2 To -PI / 2 Step -dtheta
  293.                 TheSurface.AddCurvePoint _
  294.                     R + R * Cos(theta), _
  295.                     2 * R + R * Sin(theta), _
  296.                     0
  297.             Next theta
  298.             TheSurface.AddCurvePoint R, -3, 0
  299.         Case 12 ' Helix.
  300.             R = 2
  301.             dtheta = PI / 4
  302.             For theta = -PI To PI Step dtheta
  303.                 TheSurface.AddCurvePoint _
  304.                     R * Cos(theta / 2), _
  305.                     theta, _
  306.                     R * Sin(theta / 2)
  307.             Next theta
  308.         Case 13 ' Tornado.
  309.             R = 2
  310.             dtheta = PI / 4
  311.             For theta = -PI To PI Step dtheta
  312.                 R = 2 + theta / 2
  313.                 TheSurface.AddCurvePoint _
  314.                     R * Cos(theta / 2), _
  315.                     theta, _
  316.                     R * Sin(theta / 2)
  317.             Next theta
  318.     End Select
  319. End Sub
  320. ' Create a new curve and rotate it.
  321. Private Sub optCurve_Click(Index As Integer)
  322.     Screen.MousePointer = vbHourglass
  323.     DoEvents
  324.     SelectedCurve = Index
  325.     CreateSurface
  326.     TheSurface.Rotate
  327.     DrawData picCanvas
  328.     picCanvas.SetFocus
  329.     Screen.MousePointer = vbDefault
  330. End Sub
  331. ' Draw the data.
  332. Private Sub DrawData(ByVal pic As PictureBox)
  333. Dim X As Single
  334. Dim Y As Single
  335. Dim Z As Single
  336. Dim S(1 To 4, 1 To 4) As Single
  337. Dim T(1 To 4, 1 To 4) As Single
  338. Dim ST(1 To 4, 1 To 4) As Single
  339. Dim PST(1 To 4, 1 To 4) As Single
  340.     ' Prevent overflow errors when drawing lines
  341.     ' too far out of bounds.
  342.     On Error Resume Next
  343.     ' Scale and translate so it looks OK in pixels.
  344.     m3Scale S, 35, -35, 1
  345.     m3Translate T, 180, 200, 0
  346.     m3MatMultiplyFull ST, S, T
  347.     m3MatMultiplyFull PST, Projector, ST
  348.     ' Transform the points.
  349.     TheSurface.ApplyFull PST
  350.     ' Display the data.
  351.     pic.Cls
  352.     TheSurface.Draw pic, EyeR
  353.     pic.Refresh
  354. End Sub
  355. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  356.     Select Case KeyCode
  357.         Case vbKeyLeft
  358.             EyeTheta = EyeTheta - dtheta
  359.         
  360.         Case vbKeyRight
  361.             EyeTheta = EyeTheta + dtheta
  362.         
  363.         Case vbKeyUp
  364.             EyePhi = EyePhi - Dphi
  365.         
  366.         Case vbKeyDown
  367.             EyePhi = EyePhi + Dphi
  368.                 
  369.         Case Else
  370.             Exit Sub
  371.     End Select
  372.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  373.     DrawData picCanvas
  374. End Sub
  375. Private Sub Form_KeyPress(KeyAscii As Integer)
  376.     Select Case KeyAscii
  377.         Case Asc("+")
  378.             EyeR = EyeR + Dr
  379.         
  380.         Case Asc("-")
  381.             EyeR = EyeR - Dr
  382.         
  383.         Case Else
  384.             Exit Sub
  385.     End Select
  386.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  387.     DrawData picCanvas
  388. End Sub
  389. Private Sub Form_Load()
  390.     ' Initialize the eye position.
  391.     EyeR = 10
  392.     EyeTheta = PI * 0.2
  393.     EyePhi = PI * 0.1
  394.     ' Initialize the projection transformation.
  395.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  396.     Me.Show
  397.     optCurve_Click 0
  398. End Sub
  399.